home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / jade / lisp / lisp.jl < prev    next >
Encoding:
Text File  |  1995-03-09  |  3.4 KB  |  89 lines
  1. ;;;; lisp.jl -- Some Lispy functions
  2. ;;;  Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (defvar features ()
  21.   "A list of symbols definining which ``features'' Jade currently has loaded.
  22. This is used by the `featurep', `provide' and `require' functions.")
  23.  
  24. (defun require (feature &optional file)
  25.   "If FEATURE (a symbol) has not already been loaded, load it. The file
  26. loaded is either FILE (if given), or the print name of FEATURE."
  27.   (unless (member feature features)
  28.     (load (unless file (symbol-name feature)))))
  29.  
  30. (defun provide (feature)
  31.   "Show that the feature FEATURE (a symbol) has been loaded."
  32.   (unless (member feature features)
  33.       (setq features (cons feature features))))
  34.  
  35. (defun featurep (feature)
  36.   "Return non-nil if feature FEATURE has already been loaded."
  37.   (member feature features))
  38.  
  39. (defun autoload (symbol &rest autoload-defn)
  40.   "Tell the evaluator that the function value of SYMBOL will be initialised
  41. from a named file. The AUTOLOAD-DEFN is the contents of the SYMBOL's
  42. autoload definition. Currently two items are used, the first is the name
  43. of the file to load the value of SYMBOL from. The second says whether or
  44. not the function SYMBOL may be called interactively (as a command)."
  45.   (fset symbol (cons 'autoload autoload-defn)))
  46.  
  47. (defun add-hook (hook-symbol new-func &optional at-end)
  48.   "Arrange it so that FUNCTION-NAME is added to the hook-list stored in
  49. symbol, HOOK-SYMBOL. It will added at the head of the list unless AT-END
  50. is non-nil in which case it is added at the end."
  51.   (unless (boundp hook-symbol)
  52.     (set hook-symbol nil))
  53.   (if at-end
  54.       (set hook-symbol (nconc (symbol-value hook-symbol) (cons new-func nil)))
  55.     (set hook-symbol (cons new-func (symbol-value hook-symbol)))))
  56.  
  57. (defun remove-hook (hook-symbol old-func)
  58.   "Remove FUNCTION-NAME from the hook HOOK-SYMBOL."
  59.   (set hook-symbol (delete old-func (symbol-value hook-symbol))))
  60.  
  61. (defun prin1-to-string (arg)
  62.   "Return a string representing OBJECT."
  63.   (format nil "%S" arg))
  64.  
  65. (defun read-from-string (string &optional start)
  66.   "Reads an object from STRING, starting at character number START (default
  67. is 0)."
  68.   (read (make-string-input-stream string start)))
  69.  
  70. ;; Some function pseudonyms
  71. (defmacro setcar (&rest args)
  72.   (cons 'rplaca args))
  73. (defmacro setcdr (&rest args)
  74.   (cons 'rplacd args))
  75. (defmacro string= (&rest args)
  76.   (cons 'equal args))
  77. (fset 'string-equal-p (symbol-function 'string=))
  78. (defmacro string< (&rest args)
  79.   (cons '< args))
  80. (fset 'string-less-p (symbol-function 'string<))
  81.  
  82. (defun error (&rest args)
  83.   (signal 'error (list (apply 'format nil args))))
  84.  
  85. (defun eval-and-print (form)
  86.   "Eval FORM then print its value in the status line."
  87.   (interactive "xEval: ")
  88.   (prin1 (eval form) t))
  89.